home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / demos / 57 / pascal / circle2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-09-18  |  14.8 KB  |  391 lines
  1. program circle2;
  2.  
  3. (* written by Dwight D. McKay - September 1986                  *)
  4. (* Circle2 - from SciAm Computer Recreations column, Sept. 86   *)
  5.  
  6. (* This is a public domain demo program.  Feel free to          *)
  7. (* distribute it for free; please leave this message and the    *)
  8. (* message which is displayed in the "desk" menu item in place  *)
  9. (* as that message satisfys the license agreement with OSS.     *)
  10.  
  11. const
  12.         {$I gemconst.pas}
  13.         Desk_Title = 3; { index of "desk" item in the menu bar }
  14.         MAX_X = 100;
  15.         MAX_Y = 100;
  16.  
  17. type
  18.         mode_type = (MONO, FOUR, SIXTEEN);
  19.         {$I gemtype.pas}
  20.  
  21. var
  22.         menu : Menu_Ptr;
  23.         dummy, which, handle : integer;
  24.         param_title, param0_item, param1_item, param2_item : integer;
  25.         param3_item : integer;
  26.         msg : Message_Buffer;
  27.         wind_type : integer;
  28.         title : Window_Title;
  29.  
  30.         clrs : array [0..15] of integer;
  31.         cx, cy, sz : integer;
  32.         win_x, win_y, y_fix : integer;
  33.         color_mode : mode_type;
  34.  
  35. {$I gemsubs.pas}
  36.  
  37. procedure circle2;
  38.  
  39. { run the circle2 loop with the specified parameters }
  40.  
  41. var
  42.         i, ii, j, c, ix, iy, w, h : integer;
  43.         x, y, z : real;
  44.  
  45. begin
  46.         { get the window size, set clipping }
  47.  
  48.         Work_Rect(handle, ix, iy, w, h);
  49.         Set_Clip(ix, iy, w, h);
  50.  
  51.         { clear display rectangle }
  52.  
  53.         Paint_Style(Solid);
  54.         Paint_Color(White);
  55.         Paint_Rect(ix, iy, w, h);
  56.  
  57.         if y_fix > 0 then w := trunc(w/2);
  58.         for ii := 0 to w do begin
  59.                 i := ii * (y_fix + 1);
  60.                 for j := 0 to h do begin
  61.                         x := cx + (sz * (ii/100));
  62.                         y := cy + (sz * (j/100));
  63.                         z := sqr(x) + sqr(y);
  64.                         c := trunc(z);
  65.                         case color_mode of
  66.                                 MONO :
  67.                                         begin
  68.                                                 if not(odd(c)) then begin
  69.                                                         Line_Color(Black);
  70.                                             line(i+ix, j+iy, i+ix+y_fix, j+iy);
  71.                                                 end;
  72.                                         end;
  73.                                 FOUR :
  74.                                         begin
  75.                                                 Line_Color(clrs[(c mod 4)]);
  76.                                             line(i+ix, j+iy, i+ix+y_fix, j+iy);
  77.                                         end;
  78.                                 SIXTEEN :
  79.                                         begin
  80.                                                 Line_Color(clrs[(c mod 16)]);
  81.                                             line(i+ix, j+iy, i+ix+y_fix, j+iy);
  82.                                         end;
  83.                         end;
  84.                 end;
  85.         end;
  86. end;
  87.  
  88. procedure itos(num : integer; var t : Str255);
  89.  
  90. var
  91.         i, j, k : integer;
  92.         s : array [0..10] of char;
  93.  
  94. begin
  95.         k := num;
  96.         t := '';
  97.         j := 0;
  98.         if k < 0 then begin
  99.                 t := '-';
  100.                 k := -k;
  101.         end;
  102.         while not (k = 0) do begin
  103.                 i := k - (10 * trunc(k/10));
  104.                 k := trunc(k/10);
  105.                 s[j] := chr(ord('0') + i);
  106.                 j := j + 1;
  107.         end; { while }
  108.         for i:= j-1 downto 0 do
  109.                 t := concat(t, s[i]);
  110. end;
  111.  
  112. function stoi(text : Str255) : integer;
  113.  
  114. var
  115.         i, j, k : integer;
  116.  
  117. begin
  118.         k := 1;
  119.         j := 0;
  120.         for i := 1 to length(text) do
  121.                 if text[i] = '-' then begin
  122.                         k := -1;
  123.                 end else if (ord(text[i]) >= ord('0')) or
  124.                             (ord(text[i]) <= ord('9')) then begin
  125.       j := j + trunc(PwrOfTen(length(text) - i) * (ord(text[i]) - ord('0')));
  126.                 end;
  127.         j := j * k;
  128.         stoi := j;
  129. end;
  130.  
  131. procedure param_dialog;
  132.  
  133. var
  134.         param_box : Dialog_Ptr;
  135.         cx_idx, cy_idx, sz_idx, exit_btn : integer;
  136.         text : Str255;
  137.  
  138. begin
  139.         { user picked the parameter changer }
  140.         param_box := New_Dialog(5,0,0,30,9);
  141.         cx_idx := Add_Ditem(param_box, G_FText, Editable,
  142.                         1, 1, 22, 1, 0, Black * 256 | 128);
  143.         itos(cx, text);
  144.         Set_Dedit(param_box, cx_idx, ' Lower Left X     ____ ', 'X999', text,
  145.                         System_Font, TE_Left);
  146.         cy_idx := Add_Ditem(param_box, G_FText, Editable,
  147.                         1, 3, 22, 1, 0, Black * 256 | 128);
  148.         itos(cy, text);
  149.         Set_Dedit(param_box, cy_idx, ' Lower Left Y     ____ ', 'X999', text,
  150.                         System_Font, TE_Left);
  151.         sz_idx := Add_Ditem(param_box, G_FText, Editable,
  152.                         1, 5, 22, 1, 0, Black * 256 | 128);
  153.         itos(sz, text);
  154.         Set_Dedit(param_box, sz_idx, ' Length of a side ____ ', '9999', text,
  155.                         System_Font, TE_Left);
  156.         exit_btn := Add_Ditem(param_box, G_Button,
  157.                         Selectable|Default|Touch_Exit,
  158.                         11, 7, 6, 1, 1, Black * 4096 | Black * 256);
  159.         Set_Dtext(param_box, exit_btn, ' Done ', System_Font, TE_Center);
  160.         Center_Dialog(param_box);
  161.         dummy := DO_Dialog(param_box, cx_idx);
  162.         Get_DEdit(param_box, cx_idx, text);
  163.         cx := stoi(text);
  164.         Get_DEdit(param_box, cy_idx, text);
  165.         cy := stoi(text);
  166.         Get_DEdit(param_box, sz_idx, text);
  167.         sz := stoi(text);
  168.         End_Dialog(param_box);
  169.         Delete_Dialog(param_box);
  170. end;
  171.  
  172. procedure aspect_dialog;
  173.  
  174. var
  175.         aspect_box : Dialog_Ptr;
  176.         inst_aspect_idx, one_btn, two_btn, exit_btn : integer;
  177.  
  178. begin
  179.         { aspect ratio correction box }
  180.         aspect_box := New_Dialog(5,0,0,18,7);
  181.         inst_aspect_idx := Add_DItem( aspect_box, G_Text, None,
  182.                                 1, 1, 14, 1, 0, Black * 256);
  183.         Set_DText(aspect_box, inst_aspect_idx,
  184.                 'Aspect Ratio', System_Font, TE_Center);
  185.         one_btn := Add_DItem( aspect_box, G_Button, Selectable|Radio_Btn,
  186.                                 2, 3, 5, 1, 1, Black * 4096 | Black * 256);
  187.         Set_DText(aspect_box, one_btn, '1:1', System_Font, TE_Center);
  188.         two_btn := Add_DItem( aspect_box, G_Button, Selectable|Radio_Btn,
  189.                                 9, 3, 5, 1, 1, Black * 4096 | Black * 256);
  190.         Set_DText(aspect_box, two_btn, '2:1', System_Font, TE_Center);
  191.         exit_btn := Add_DItem( aspect_box, G_Button,
  192.                                 Selectable|Default|Touch_Exit,
  193.                                 5, 5, 6, 1, 1, Black * 4096 | Black * 256);
  194.         Set_DText(aspect_box, exit_btn, ' Done ', System_Font, TE_Center);
  195.         if y_fix = 0 then
  196.                 Obj_SetState(aspect_box, one_btn, Selected, false)
  197.         else
  198.                 Obj_SetState(aspect_box, two_btn, Selected, false);
  199.         Center_Dialog(aspect_box);
  200.         dummy := Do_Dialog(aspect_box, 0);
  201.         if Obj_State(aspect_box, one_btn) & Selected <> 0 then
  202.                 y_fix := 0
  203.         else
  204.                 y_fix := 1;
  205.         End_Dialog(aspect_box);
  206.         Delete_Dialog(aspect_box);
  207. end;
  208.  
  209. procedure color_dialog;
  210.  
  211. var
  212.         color_box : Dialog_ptr;
  213.         inst_color, two_btn, four_btn, sixteen_btn, exit_btn : integer;
  214.  
  215. begin
  216.         { number of colors to use dialog }
  217.         color_box := New_Dialog(5,0,0,18,7);
  218.         inst_color := Add_DItem( color_box, G_Text, None,
  219.                                 1, 1, 16, 1, 0, Black * 256);
  220.         Set_DText( color_box, inst_color, 'Number of Colors', System_Font,
  221.                 TE_Center);
  222.         two_btn := Add_DItem( color_box, G_Button, Selectable|Radio_Btn,
  223.                                 3, 3, 3, 1, 1, Black * 4096 | Black * 256);
  224.         Set_DText( color_box, two_btn, '2', System_Font, TE_Center);
  225.         four_btn := Add_DItem( color_box, G_Button, Selectable|Radio_Btn,
  226.                                 7, 3, 3, 1, 1, Black * 4096 | Black * 256);
  227.         Set_DText( color_box, four_btn, '4', System_Font, TE_Center);
  228.         sixteen_btn := Add_DItem( color_box, G_Button, Selectable|Radio_Btn,
  229.                                 11, 3, 4, 1, 1, Black * 4096 | Black * 256);
  230.         Set_DText( color_box, sixteen_btn, '16', System_Font, TE_Center);
  231.         exit_btn := Add_DItem( color_box, G_Button,
  232.                                 Selectable|Default|Touch_Exit,
  233.                                 6, 5, 6, 1, 1, Black * 4096 | Black * 256);
  234.         Set_DText( color_box, exit_btn, 'Done', System_Font, TE_Center);
  235.         case color_mode of
  236.                 MONO: Obj_SetState( color_box, two_btn, Selected, false);
  237.                 FOUR: Obj_SetState( color_box, four_btn, Selected, false);
  238.                 SIXTEEN:Obj_SetState( color_box, sixteen_btn, Selected, false);
  239.         end; { case }
  240.         Center_Dialog( color_box );
  241.         dummy := Do_Dialog( color_box, 0);
  242.         if Obj_State( color_box, two_btn) & Selected <> 0 then
  243.                 color_mode := MONO
  244.         else if Obj_State( color_box, four_btn) & Selected <> 0 then
  245.                 color_mode := FOUR
  246.         else
  247.                 color_mode := SIXTEEN;
  248.         End_Dialog( color_box );
  249.         Delete_Dialog( color_box );
  250. end;
  251.  
  252. procedure do_menu(title, item : integer);
  253.  
  254. { take care of what happens when the user hits a menu item }
  255.  
  256. var
  257.         alert : Str255;
  258.  
  259. begin
  260.         if title = Desk_Title then begin
  261.  
  262.                 { user picked the "desk" item, show program info }
  263.  
  264.                 alert := '[0][';
  265.                 alert := Concat(alert, '             Circle2|');
  266.                 alert := Concat(alert, '   Written by Dwight D. Mckay|');
  267.                 alert := Concat(alert, '  Portions of this product are|');
  268.                 alert := Concat(alert, 'Copyright (c) 1986, OSS and CCD.|');
  269.                 alert := Concat(alert, '   Used by Permission of OSS.]');
  270.                 alert := Concat(alert, '[ OK ]');
  271.                 dummy := Do_Alert(alert,1);
  272.  
  273.         end else if title = param_title then begin
  274.             if item = param0_item then param_dialog
  275.             else if item = param1_item then aspect_dialog
  276.             else if item = param2_item then color_dialog
  277.             else if item = param3_item then begin
  278.                 Hide_Mouse;
  279.                 Begin_Update;
  280.                 circle2;
  281.                 End_Update;
  282.                 Show_Mouse;
  283.             end;
  284.         end;
  285.  
  286.         { turn the selected menu off again }
  287.  
  288.         Menu_Normal(menu, title);
  289. end; { procedure do_menu }
  290.  
  291. begin { circle2 }
  292.         { set initial parameters }
  293.         cx := -20;
  294.         cy := -20;
  295.         sz := 40;
  296.         clrs[0] := White;
  297.         clrs[1] := Black;
  298.         clrs[2] := Red;
  299.         clrs[3] := Green;
  300.         clrs[4] := Blue;
  301.         clrs[5] := Cyan;
  302.         clrs[6] := Yellow;
  303.         clrs[7] := Magenta;
  304.         clrs[8] := L_White;
  305.         clrs[9] := L_Black;
  306.         clrs[10] := L_Red;
  307.         clrs[11] := L_Green;
  308.         clrs[12] := L_Blue;
  309.         clrs[13] := L_Cyan;
  310.         clrs[14] := L_Yellow;
  311.         clrs[15] := L_Magenta;
  312.         color_mode := MONO;
  313.         y_fix := 0;
  314.  
  315.         if Init_Gem >= 0 then begin { we got a good GEM startup... }
  316.  
  317.                 { first set up for a window }
  318.                 Set_Mouse(M_Bee);
  319.                 wind_type := G_Size|G_Move|G_Close|G_Name;
  320.                 title := ' Circle2 ';
  321.                 handle := New_Window(wind_type, title, 0, 0, 0, 0);
  322.  
  323.                 { next set up for the menu bar }
  324.                 menu := New_Menu(6, '  About Circle2  ');
  325.            param_title := Add_MTitle(menu, ' Commands ');
  326.            param0_item := Add_MItem(menu, param_title, '   Parameters    ');
  327.            param1_item := Add_Mitem(menu, param_title, '   Aspect Ratio  ');
  328.            param2_item := Add_MItem(menu, param_title, '   Colors        ');
  329.            param3_item := Add_Mitem(menu, param_title, '   Redraw        ');
  330.  
  331.                 { OK, now do it... }
  332.                 Draw_Menu(menu);
  333.                 Open_Window(handle, 10, 20, MAX_X, MAX_Y);
  334.  
  335.                 { now loop until the user closes the window, handling events }
  336.  
  337.                 Set_Mouse(M_Arrow);
  338.  
  339.                 repeat
  340.                         { check for an event }
  341.                         which := Get_Event(E_Message, 0, 0, 0, 2000,
  342.                                 false, 0, 0, 0, 0, false, 0, 0, 0, 0,
  343.                                 msg, dummy, dummy, dummy, dummy, dummy, dummy);
  344.  
  345.                         { if we got some message, deal with it }
  346.  
  347.                         if which & E_Message <> 0 then
  348.  
  349.                                 case msg[0] of
  350.                                         { redraw the window }
  351.                                         WM_Redraw :
  352.                                                 begin
  353.                                                         Hide_Mouse;
  354.                                                         Begin_Update;
  355.                                                         circle2;
  356.                                                         End_Update;
  357.                                                         Show_Mouse;
  358.                                                 end;
  359.  
  360.                                         { moved or sized, fix things up... }
  361.                                         WM_Sized, WM_Moved :
  362.                                                 begin
  363.                                                         win_x := msg[6];
  364.                                                         win_y := msg[7];
  365.                                                         Set_WSize(handle,
  366.                                                                 msg[4],
  367.                                                                 msg[5],
  368.                                                                 msg[6],
  369.                                                                 msg[7]);
  370.                                                         Hide_Mouse;
  371.                                                         Begin_Update;
  372.                                                         circle2;
  373.                                                         End_Update;
  374.                                                         Show_Mouse;
  375.                                                 end;
  376.  
  377.                                         { some menu was hit... }
  378.                                         MN_Selected :
  379.                                                 do_menu(msg[3], msg[4]);
  380.                                 end;
  381.                 until msg[0] = WM_Closed;
  382.  
  383.                 { user hit the "close" box, so clean up and exit }
  384.  
  385.                 Close_Window(handle);
  386.                 Delete_Window(handle);
  387.                 Erase_menu(menu);
  388.                 Exit_Gem;
  389.         end;
  390. end.
  391.